/* ** $VER: WebYAM 1.3 (18.2.2001) ** © 2000-2001 by Jacob Laursen ** ** Web browse YAM folders ** ** Requirements: Apache (or some other web server) ** YAM 2.3+ ** ** For "quoted printable" -> "8bit" conversion, please download ** comm/mail/YToolsNG.lha from Aminet and copy the file 'YTCunmime' ** to the YAM: directory, or correct the path below. ** ** Version 1.3 - Fixed version check bug. ** - Sent folders will now have the "To:" name displayed ** instead of the "From:" name. ** ** Version 1.2 - Optimized folder scan drastically (YAM 2.2 feature) ** Added advanced compose mode ** One more security exploit eliminated ** (HTML tags in subject wasn't translated) ** Signature is no longer added if "Add signature" ** is de-selected (work-around for bug in YAM). ** ** Version 1.1 - Added configuration options ** - Added URL links in mails ** - Improved security (exploit eliminated) ** - Two separators in a row is now supported ** ** Version 1.0 - Initial release. ** ** TODO: ** - Process headers (and don't show irrelevant header lines) ** - Join "Folders" and "Folders (full)". */ options results options failat 11 /* YAM executable path */ YAMPath = 'YAM:YAM' /* YAM folder file */ Cfg.YAMFolders = 'YAM:.folders' /* WebYAM config file */ Cfg.WebYAM = 'WebYAM.config' /* YTCunmime executable path */ Cfg.UMPath = 'YAM:YTCunmime' /* Misc. appearance options */ Cfg.MsgsPerPage = 25 /* Number of messages per page */ Cfg.NumColsQuick = 4 /* Number of columns in quick folder list */ Cfg.NumColsFull = 2 /* Number of columns in full folder list */ /* Color settings - only RRGGBB values accepted */ Cfg.FldrHdrColor = '333366' Cfg.BgColor = 'eeeecc' /* No user-serviceable parts below... */ say 'Content-type: text/html'; say '' say ''; say '' say ' ' say ' Yet Another Mailer - Web Interface' if ~show('P','YAM') then do say ' ' say ' '; say '' say ' ' say '

Please wait, loading YAM...

' say ' ' say '' address command 'Run <>NIL: ' || YAMPath || ' HIDE' exit end say ' '; say '' say ' ' if ~show('L','rexxdossupport.library') then if ~addlib('rexxdossupport.library',0,-30,0) then do say '

Error: rexxdossupport.library couldn''t be opened!

' say ' ' say '' exit 10 end 'getvar QUERY_STRING'; query = result call ParseConfig call ParseArgs(query) address 'YAM' /* YAM Version check */ INFO 'VERSION' parse var RESULT '$VER: YAM ' major '.' minor . if datatype(minor) ~= 'NUM' then minor = left(minor,1) /* Please note that this needs to be fixed in case of revisions > 9 */ if datatype(major) = 'NUM' & datatype(minor) = 'NUM' then do if major < 2 | (major = 2 & minor < 3) then do say '

YAM 2.3 required (installed version: 'major'.'minor').

' say ' ' say '' exit 10 end end if Arg.Check = 1 then call GetMail if Arg.Save = 1 then call SaveConfig if Arg.Help = 1 then call Help else if Arg.Config = 1 then call Config else if Arg.Compose = 1 then call ComposeMail else if Arg.Send = 1 then call SendMail else if Arg.List = 1 then call ListFolders else if Arg.Folder > -1 then do if Arg.Message > -1 then do if Arg.Move = 1 then call MoveMail else if Arg.Delete = 1 then call DeleteMail else call ReadMessage(Arg.Folder, Arg.Message) end else do if Arg.Move = 1 then call MoveMails(Arg.Folder, Arg.Page) else if Arg.Delete = 1 then call DeleteMails(Arg.Folder, Arg.Page) else call ListFolder(Arg.Folder, Arg.Page) end end else call ListDeadFolders say ' ' say '' exit ParseArgs: PROCEDURE EXPOSE Arg. Cfg. parse arg string Arg.List = 0 Arg.Check = 0 Arg.Config = 0 Arg.Help = 0 Arg.Compose = 0 Arg.Advanced = 0 Arg.Send = 0 Arg.Save = 0 Arg.Signature = 0 Arg.Keep = 1 Arg.Folder = -1 Arg.DestFolder = -1 Arg.Message = -1 Arg.Page = 1 Arg.Delete = 0 Arg.Move = 0 Arg.Msgs.COUNT = 0 Arg.From = '' Arg.ReplyTo = '' Arg.Cc = '' Arg.Bcc = '' query = translate(string, ' ', '&') do loop = 1 to words(query) arg = word(query,loop) if index(arg,'=') > 1 then do cmd = left(arg,index(arg,'=')-1) parse var arg cmd'='value cmd = upper(cmd) select when cmd = 'FOLDER' then Arg.Folder = value when cmd = 'DESTFOLDER' then Arg.DestFolder = value when cmd = 'MESSAGE' then Arg.Message = value when cmd = 'PAGE' then Arg.Page = value when cmd = 'OPTION' & upper(value) = 'DELETE' then Arg.Delete = 1 when cmd = 'OPTION' & upper(value) = 'MOVE+TO' then Arg.Move = 1 when cmd = 'SEND' & upper(value) = 'SEND' then Arg.Send = 1 when cmd = 'SAVE' & upper(value) = 'SAVE' then Arg.Save = 1 when cmd = 'MSGSPERPAGE' & datatype(value) = 'NUM' then Cfg.MsgsPerPage = value when cmd = 'NUMCOLSQUICK' & datatype(value) = 'NUM' then Cfg.NumColsQuick = value when cmd = 'FROM' then Arg.From = Convert(value) when cmd = 'REPLYTO' then Arg.ReplyTo = Convert(value) when cmd = 'TO' then Arg.Recipient = Convert(value) when cmd = 'CC' then Arg.Cc = Convert(value) when cmd = 'BCC' then Arg.Bcc = Convert(value) when cmd = 'SUBJECT' then Arg.Subject = Convert(value) when cmd = 'BODY' then Arg.Body = Convert(value) when cmd = 'SIGNATURE' & upper(value) = 'ON' then Arg.Signature = 1 when cmd = 'KEEP' & upper(value) = 'OFF' then Arg.Keep = 0 when left(cmd,8) = 'MESSAGE.' then do parse var arg dummy'.'num'='val current = Arg.Msgs.COUNT if upper(val) = 'ON' then do Arg.Msgs.current = num Arg.Msgs.COUNT = current + 1 end end end end else do arg = upper(arg) if arg = 'LIST' then Arg.List = 1 if arg = 'CHECK' then Arg.Check = 1 if arg = 'CONFIG' then Arg.Config = 1 if arg = 'HELP' then Arg.Help = 1 if arg = 'COMPOSE' then Arg.Compose = 1 if arg = 'ADVANCED' then Arg.Advanced = 1 end end return ParseConfig: PROCEDURE EXPOSE Cfg. if ~exists(Cfg.WebYAM) then return call open(fh, Cfg.WebYAM, 'R') do while ~eof(fh) line = readln(fh) key = upper(word(line, 1)) arg = word(line, 2) if key = 'MSGSPERPAGE' & datatype(arg) = 'NUM' then Cfg.MsgsPerPage = arg else if key = 'NUMCOLSQUICK' & datatype(arg) = 'NUM' then Cfg.NumColsQuick = arg end call close(fh) return SaveConfig: PROCEDURE EXPOSE Cfg. call open(fh, Cfg.WebYAM, 'W') call writeln(fh, 'MsgsPerPage 'Cfg.MsgsPerPage) call writeln(fh, 'NumColsQuick 'Cfg.NumColsQuick) call close(fh) return ParseFolders: PROCEDURE EXPOSE Cfg. if ~exists(Cfg.YAMFolders) then return call open(fh, Cfg.YAMFolders, 'R') Cfg.FolderName.COUNT = 0 do while ~eof(fh) line = readln(fh) if word(line, 1) = '@FOLDER' then do current = Cfg.FolderName.COUNT Cfg.FolderName.current = 'F:'right(line,length(line)-8) Cfg.FolderName.COUNT = current + 1 end else if word(line, 1) = '@SEPARATOR' then do current = Cfg.FolderName.COUNT if length(line) > 11 then Cfg.FolderName.current = 'S:'right(line,length(line)-11) else Cfg.FolderName.current = 'S:' Cfg.FolderName.COUNT = current + 1 end end call close(fh) return GotoMail: PROCEDURE parse arg num SETMAIL num if RC ~= 10 then return 0 else say '

This mail does not exist -- please update message list.

' return 10 GotoFolder: PROCEDURE parse arg num SETFOLDER num if RC ~= 10 then return 0 else say '

This folder does not exist -- please update folder list.

' return 10 Config: PROCEDURE EXPOSE Cfg. say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mailFoldersFolders (full)ConfigHelp
' say ' ' say ' ' say ' ' say ' ' say '
Configuration
' say '
' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
Messages per Page
Columns quick
' say ' ' say '
' return ListFolders: PROCEDURE EXPOSE Cfg. say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mailFoldersFolders (full)ConfigHelp
' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' call GoBusy USERINFO STEM uinfo. do i = 0 to uinfo.FOLDERS-1 FOLDERINFO i STEM cfi. if RC = 10 then iterate say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' end APPNOBUSY say '
No.FolderTotalUnreadNew
'cfi.NUMBER''cfi.NAME''cfi.TOTAL''cfi.UNREAD''cfi.NEW'
'; say return ListDeadFolders: PROCEDURE EXPOSE Cfg. if ~exists(Cfg.YAMFolders) then do call ListFolders return end say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mailFoldersFolders (full)ConfigHelp
' call ParseFolders say ' ' say ' ' do loop = 0 to Cfg.NumColsQuick-1 say ' ' say ' ' end say ' ' step = Cfg.FolderName.COUNT/Cfg.NumColsQuick if trunc(step) ~= step then step = trunc(step)+1 do mainloop = 0 to step-1 say ' ' do loop = 0 to Cfg.NumColsQuick-1 current = mainloop+loop*step if current > Cfg.FolderName.COUNT-1 then leave if left(cfg.FolderName.current, 2) = 'F:' then do say ' ' say ' ' end end say ' ' end say '
No.Folder
'current''right(cfg.FolderName.current, length(cfg.FolderName.current)-2)'
'; say return DeleteMail: PROCEDURE EXPOSE Arg. Cfg. Arg.Msgs.COUNT = 1 Arg.Msgs.0 = Arg.Message call DeleteMails(Arg.Folder, Arg.Page) return DeleteMails: PROCEDURE EXPOSE Arg. Cfg. parse arg folder, page call GoBusy RC = GotoFolder(folder) if RC = 10 then do APPNOBUSY return end do loop=Arg.Msgs.COUNT-1 to 0 by -1 RC = GotoMail(Arg.Msgs.loop) if RC = 10 then leave MAILDELETE 'FORCE' end APPNOBUSY call ListFolder(folder, page) return MoveMail: PROCEDURE EXPOSE Arg. Cfg. Arg.Msgs.COUNT = 1 Arg.Msgs.0 = Arg.Message call MoveMails(Arg.Folder, Arg.Page) return MoveMails: PROCEDURE EXPOSE Arg. Cfg. parse arg folder, page call GoBusy RC = GotoFolder(folder) if RC = 10 then do APPNOBUSY return end do loop=Arg.Msgs.COUNT-1 to 0 by -1 RC = GotoMail(Arg.Msgs.loop) if RC = 10 then leave MAILMOVE Arg.DestFolder end APPNOBUSY call ListFolder(folder, page) return ListFolder: PROCEDURE EXPOSE Cfg. parse arg folder, page call ParseFolders call GoBusy RC = GotoFolder(folder) if RC = 10 then do APPNOBUSY return end FOLDERINFO STEM fi. start = Cfg.MsgsPerPage * (page-1) end = Cfg.MsgsPerPage * page if end > fi.TOTAL then end = fi.TOTAL pages = trunc((fi.TOTAL-1)/Cfg.MsgsPerPage)+1 say '
' say ' ' say ' ' say ' ' say ' ' say ' ' pageinfo = ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
Folder: 'right(Cfg.FolderName.folder, length(Cfg.FolderName.folder)-2)'Page 'page' of 'pages' [' do loop = 1 to pages if loop = page then pageinfo = pageinfo' 'loop else pageinfo = pageinfo' 'loop'' end say pageinfo' ]
ComposeGet mailFoldersFolders (full)ConfigHelp
' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' do loop = start to end-1 MAILINFO loop STEM sel. if fi.TYPE = 3 | fi.TYPE = 6 then name = sel.TO else name = sel.FROM if index(name,'<') ~= 0 then email = left(name,index(name,'<')-2) else email = name subj = Replace(sel.SUBJECT, '<', '<') subj = Replace(subj, '>', '>') say ' ' if sel.STATUS = 'U' | sel.STATUS = 'N' then say ' ' else say ' ' say ' ' say ' ' estr = ' ' say estr say ' ' say ' ' say ' ' imgstat = ' ' say ' ' end APPNOBUSY say ' ' say ' ' temp = ' ' say ' ' say '
New  No.NameSubjectDateSizeFlags 
New  'sel.INDEX+1' ' if left(sel.FLAGS,1) = 'M' then estr = estr'M ' estr = estr''email' 'subj' 'sel.DATE''sel.SIZE' ' if substr(sel.FLAGS,2,1) = 'A' then imgstat = imgstat'A ' if substr(sel.FLAGS,3,1) = 'R' then imgstat = imgstat'R ' if substr(sel.FLAGS,4,1) = 'C' then imgstat = imgstat'C ' if substr(sel.FLAGS,5,1) = 'S' then imgstat = imgstat'S ' if sel.STATUS = 'O' then imgstat = imgstat'O' else if sel.STATUS = 'N' then imgstat = imgstat'N' else if sel.STATUS = 'R' then imgstat = imgstat'R' else if sel.STATUS = 'U' then imgstat = imgstat'U' else if sel.STATUS = 'F' then imgstat = imgstat'F' else if sel.STATUS = 'S' then imgstat = imgstat'S' else if sel.STATUS = 'W' then imgstat = imgstat'W' else if sel.STATUS = 'H' then imgstat = imgstat'H' else if sel.STATUS = 'E' then imgstat = imgstat'E' say imgstat' 
[ ' if page = 1 then temp = temp'Prev Page' else temp = temp'Prev Page' temp = temp' | ' if page = pages then temp = temp'Next Page' else temp = temp'Next Page' say temp' ]
'; say call MakeMoveTo(folder) say '
' return ReadMessage: PROCEDURE EXPOSE Cfg. parse arg folder, message call GoBusy RC = GotoFolder(folder) if RC = 10 then do APPNOBUSY return end RC = GotoMail(message) if RC = 10 then do APPNOBUSY return end call ParseFolders FOLDERINFO STEM cfi. say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mail'cfi.NAME'FoldersFolders (full)ConfigHelp
' MAILEXPORT 'T:YAM-TextMode.tmp' if exists(Cfg.UMPath) = 1 then address command Cfg.UMPath || ' MAIL=T:YAM-TextMode.tmp' say ' 
'

  call open(fh, 'T:YAM-TextMode.tmp', 'R')
  do while ~eof(fh)
    line = readln(fh)
    if line = '-- ' then say '
'
    else do
      line = Replace(line, '<', '<')
      line = Replace(line, '>', '>')
      say LinkURL(line)
    end
  end

  call close(fh)

  say '
' address command 'Delete >NIL: T:YAM-TextMode.tmp' MAILINFO STEM sel. if sel.STATUS = 'N' | sel.STATUS = 'U' then MAILSTATUS 'O' APPNOBUSY say '
' say ' ' say ' ' call ParseFolders call MakeMoveTo(folder) say ' ' say ' ' say ' Compose' say ' Get mail' say ' Folders' say ' Folders (full)' say ' Config' say ' Help' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' if Arg.Advanced = 1 then do say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' end say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' if Arg.Advanced = 1 then do say ' ' say ' ' say ' ' end say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
' say ' ' say ' ' if Arg.Advanced = 0 then say ' Advanced' else say ' Simple' say '
From:' say '
Reply-To:' say '
To:' say '
Cc:' say '
Bcc:' say '
Subject:' say '
' say ' Add signature' say ' Delete when sent' say '
' say ' ' say ' ' say ' ' say ' ' say '
' say ' ' say '
' say '
' return SendMail: PROCEDURE EXPOSE Arg. call open(fh, 'T:WebYAM-write.tmp', 'W') call writeln(fh, Arg.body) call close(fh) call GoBusy 'MAILWRITE QUIET' WRITETO '"'Arg.Recipient'"' if Arg.From ~= '' then WRITEFROM '"'Arg.From'"' if Arg.ReplyTo ~= '' then WRITEREPLYTO '"'Arg.ReplyTo'"' if Arg.Cc ~= '' then WRITECC '"'Arg.Cc'"' if Arg.Bcc ~= '' then WRITEBCC '"'Arg.Bcc'"' WRITESUBJECT '"'Arg.Subject'"' if Arg.Signature = 0 then WRITELETTER 'T:WebYAM-write.tmp' NOSIG else WRITELETTER 'T:WebYAM-write.tmp' if Arg.Keep = 0 then 'WRITEOPTIONS DELETE' else WRITEOPTIONS WRITESEND APPNOBUSY address command 'Delete >NIL: T:WebYAM-write.tmp' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mailFoldersFolders (full)ConfigHelp
' say '
' say '

Your mail was succesfully sent.

' return Help: PROCEDURE say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say '
ComposeGet mailFoldersFolders (full)ConfigHelp
' say '
' say '

WebYAM 1.3 by Jacob Laursen

'; say say '

Browse your YAM folders through the World Wide Web.

' say '

' say ' Author''s e-mail address: laursen@myself.com
' say ' WebYAM homepage: http://home.worldonline.dk/~jlaur/amiga/webyam/
' say ' Status icons by Ash Thomas' say '

'; say say '

YAM information

'; say say ' ' return Convert: PROCEDURE parse arg dummy dummy = translate(dummy, ' ', '+') do until pos=0 pos=index(dummy,'%') if pos>0 then do hex=substr(dummy,pos+1,2) char=x2c(hex) if pos=1 then dummy=char||substr(dummy,pos+3) if pos>1 & pos' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' say ' ' return Replace: PROCEDURE parse arg String,Old,New do while index(String,Old) ~= 0 interpret "parse var String left '"Old"' right" String = left || New || right end return String LinkURL: PROCEDURE parse arg line p = index(line, 'http://') q = index(line, 'www') if p ~= 0 | q ~= 0 then do if p = 0 | (p > q & q > 0) then p = q len = length(line) l = left(line, p-1) /* URL start position: len-p+1 */ url = right(line, len-p+1) /* This is the URL followed by the rest of the line */ parse var url url . /* Cut what we know for sure is not a part of the URL */ i = length(url) c = substr(url, i, 1) do while ~datatype(c, 'ALPHANUMERIC') & c ~= '/' & i > 1 i = i - 1 c = substr(url, i, 1) end if i > 1 then url = left(url, i) else url = '' r = right(line, length(line)-length(url)-p+1) if left(url, 7) ~= 'http://' then ref = 'http://' || url else ref = url return l || '' || url || '' || LinkURL(r) /* Recurse until all references have been made */ end return line